home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / error.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  4.2 KB  |  139 lines
  1. ;-*- mode:lisp; package: boxer; fonts: cptfont -*-
  2.  
  3. ;;; (C) Copyright 1985 Massachusetts Institute of Technology
  4. ;;;
  5. ;;; Permission to use, copy, modify, distribute, and sell this software
  6. ;;; and its documentation for any purpose is hereby granted without fee,
  7. ;;; provided that the above copyright notice appear in all copies and that
  8. ;;; both that copyright notice and this permission notice appear in
  9. ;;; supporting documentation, and that the name of M.I.T. not be used in
  10. ;;; advertising or publicity pertaining to distribution of the software
  11. ;;; without specific, written prior permission.  M.I.T. makes no
  12. ;;; representations about the suitability of this software for any
  13. ;;; purpose.  It is provided "as is" without express or implied warranty.
  14. ;;;
  15.  
  16. ;;; Boxer Error checking macros
  17.  
  18. (DEFUN CHECK-NUMBER-ARGS (&REST NUMBER-LIST)
  19.   (UNLESS (EVERY NUMBER-LIST #'NUMBERP)
  20.      (FERROR "An input was not a number")))
  21.  
  22. ;;; error conditions and handlers for them...
  23. ;;; This is at the SYSTEM level 
  24.  
  25.  
  26. ;;;; ERROR-OBJECTs
  27.  
  28. (DEFFLAVOR BOXER-ERROR
  29.     ((TYPE NIL)
  30.      (FORMAT-CTL NIL)
  31.      (FORMAT-ARG NIL))
  32.     (ERROR)
  33.   :INITABLE-INSTANCE-VARIABLES)
  34.  
  35. (DEFMETHOD (BOXER-ERROR :BUG-REPORT-RECIPIENT-SYSTEM) ()
  36.   'BOXER)
  37.  
  38. (DEFMETHOD (BOXER-ERROR :AFTER :INIT) (&REST IGNORE)
  39.   (IF *BOXER-ERROR-HANDLER-P*
  40.       (TELL SELF :REPORT-ERROR-TO-BUG-BOXER)))
  41.  
  42. (DEFMETHOD (BOXER-ERROR :REPORT-ERROR-TO-BUG-BOXER) ()
  43.   NIL)
  44.  
  45. (DEFMETHOD (BOXER-ERROR :REPORT) (STREAM)
  46.   (COND ((AND (NOT-NULL FORMAT-CTL) (LISTP FORMAT-ARG))
  47.      (LEXPR-FUNCALL 'FORMAT STREAM FORMAT-CTL FORMAT-ARG))
  48.     ((NOT-NULL FORMAT-CTL)
  49.      (FORMAT STREAM FORMAT-CTL FORMAT-ARG))
  50.     (T (FORMAT STREAM "A Boxer Error of type ~S has occured." TYPE))))
  51.  
  52. (DEFFLAVOR BOXER-INTERNAL-EDITOR-ERROR
  53.     ()
  54.     (BOXER-ERROR))
  55.  
  56. (DEFFLAVOR BOXER-BP-ERROR
  57.     ()
  58.     (BOXER-ERROR))
  59.  
  60. (DEFFLAVOR BOXER-UNDEFINED-FUNCTION-ERROR
  61.     ()
  62.     (BOXER-ERROR))
  63.  
  64. (DEFFLAVOR BOXER-STACK-HACKER-ERROR
  65.     ()
  66.     (BOXER-ERROR))
  67.  
  68.  
  69.  
  70.  
  71. (DEFFLAVOR BOXER-SET-TYPE-ERROR
  72.     ((TYPE NIL)
  73.      (BOX NIL))
  74.     (BOXER-INTERNAL-EDITOR-ERROR)
  75.   :INITABLE-INSTANCE-VARIABLES
  76.   :GETTABLE-INSTANCE-VARIABLES
  77.   :OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES)
  78.  
  79. (DEFMETHOD (BOXER-SET-TYPE-ERROR :REPORT) (STREAM)
  80.   (FORMAT STREAM "Cannot change the box, ~S, to the type ~S" BOX TYPE))
  81.  
  82. (DEFUN BOXER-SET-TYPE-ERROR-HANDLER (CONDITION)
  83.   CONDITION ;the variable was bound but.....
  84.   NIL)
  85. ;  (WHEN (MEMQ (BOXER-SET-TYPE-ERROR-TYPE CONDITION)
  86. ;          '(:TURTLE-BOX TURTLE-BOX :GRAPHICS-BOX GRAPHICS-BOX))
  87. ;    (TELL CONDITION :PROCEED :COMPLEX-CHANGE)))
  88.  
  89. (DEFMETHOD (BOXER-SET-TYPE-ERROR :CASE :PROCEED :NEW-TYPE)
  90.        (&OPTIONAL (NEW-TYPE (PROMPT-AND-READ :EXPRESSION "Type to use instead: ")))
  91.   "Supply a different type. "
  92.   (VALUES ':NEW-TYPE (TELL BOX :SET-TYPE NEW-TYPE)))
  93.  
  94. (COMMENT                    ;it doesn't work
  95. (DEFMETHOD (BOXER-SET-TYPE-ERROR :CASE :PROCEED :COMPLEX-CHANGE) ()
  96.   "Changing flavors when all the instance variables are not the same. "
  97.   ;; first we put all the essential information into the plist of the box
  98.   (LET ((SCREEN-BOX (CAR (TELL BOX :DISPLAYED-SCREEN-OBJS))))
  99.     ;; we really want the actual unclipped size of the box for this (or do we ?)
  100.     (TELL BOX :PUTPROP (TELL BOX :SUPERIOR-ROW) ':SUPERIOR-ROW)
  101.     (WHEN (AND (NULL (TELL BOX :GET ':FIXED-WID)) (NULL (TELL BOX :GET ':FIXED-HEI)))
  102.       (MULTIPLE-VALUE-BIND (CURRENT-WID CURRENT-HEI)
  103.       (SCREEN-OBJ-SIZE SCREEN-BOX)
  104.     (TELL BOX :PUTPROP CURRENT-WID ':FIXED-WID)
  105.     (TELL BOX :PUTPROP CURRENT-HEI ':FIXED-HEI))))
  106.   ;; now we bind the plist and then we change the flavor descriptor and reinitalize changed
  107.   ;; box from the bound plist
  108.   (LET ((TEMP-PLIST (TELL BOX :PLIST))
  109.     (NEW-FLAVOR-DESCRIPTOR (GET TYPE 'SI:FLAVOR)))
  110.     (%P-STORE-POINTER BOX NEW-FLAVOR-DESCRIPTOR)
  111.     (TELL BOX :INIT TEMP-PLIST))
  112.   (VALUES ':COMPLEX-CHANGE BOX))
  113.  
  114. )
  115.  
  116.  
  117.  
  118. ;;; Redisplay errors
  119.  
  120. (DEFFLAVOR BOXER-REDISPLAY-ERROR
  121.     ()
  122.     (BOXER-ERROR))
  123.  
  124. (DEFMETHOD (BOXER-REDISPLAY-ERROR :REPORT) (STREAM)
  125.   (COND ((AND (NOT-NULL FORMAT-CTL) (LISTP FORMAT-ARG))
  126.      (LEXPR-FUNCALL 'FORMAT STREAM FORMAT-CTL FORMAT-ARG))
  127.     ((NOT-NULL FORMAT-CTL)
  128.      (FORMAT STREAM FORMAT-CTL FORMAT-ARG))
  129.     (T (FORMAT STREAM "A Boxer Redisplay Error of type ~S has occured." TYPE))))
  130.  
  131. (DEFFLAVOR BOXER-CURSOR-REDISPLAY-ERROR
  132.     ()
  133.     (BOXER-REDISPLAY-ERROR))
  134.  
  135. (DEFFLAVOR BOXER-REGION-REDISPLAY-ERROR
  136.     ()
  137.     (BOXER-REDISPLAY-ERROR))
  138.  
  139.